Laboratorio 7: Explicabilidad e Interpretabilidad de Modelos

Técnicas XAI (eXplainable AI) aplicadas a Random Forest

Autor/a

Minería de Datos

1 INTRODUCCIÓN A LA EXPLICABILIDAD

1.1 ¿Qué es XAI (eXplainable AI)?

La explicabilidad o interpretabilidad de modelos de machine learning se refiere a la capacidad de entender y justificar las predicciones que hace un modelo.

1.1.1 ¿Por qué es importante?

  1. Confianza: Los stakeholders necesitan entender por qué el modelo toma ciertas decisiones
  2. Regulación: GDPR y otras regulaciones requieren “derecho a la explicación”
  3. Debugging: Detectar sesgos, errores o comportamientos inesperados
  4. Mejora: Identificar qué variables son importantes para mejorar la recolección de datos
  5. Ética: Asegurar que las decisiones automatizadas son justas y no discriminatorias

1.1.2 Tipos de Explicabilidad

1. Explicabilidad Global (Model-level) - ¿Cómo funciona el modelo en general? - ¿Qué variables son más importantes? - ¿Cómo se relacionan las variables con la predicción?

2. Explicabilidad Local (Prediction-level) - ¿Por qué el modelo hizo esta predicción específica? - ¿Qué variables contribuyeron más a esta decisión? - ¿Qué cambios harían que la predicción fuera diferente?

1.1.3 Modelos Interpretables vs Cajas Negras

# Cargar librerías necesarias
library(tidyverse)
library(randomForest)
library(pdp)           # Partial Dependence Plots
library(DALEX)         # Dashboard for eXplanations
library(iml)           # Interpretable Machine Learning
library(caret)
library(gridExtra)
library(reshape2)

# Configurar semilla para reproducibilidad
set.seed(123)

# Crear tabla comparativa
interpretabilidad <- data.frame(
  Modelo = c("Regresión Lineal", "Árbol de Decisión", "Naive Bayes", 
             "k-NN", "Random Forest", "SVM", "Redes Neuronales"),
  Interpretabilidad = c("Alta", "Alta", "Media", "Baja", "Baja", "Muy Baja", "Muy Baja"),
  Rendimiento = c("Bajo-Medio", "Medio", "Medio", "Medio-Alto", "Alto", "Alto", "Muy Alto"),
  Necesita_XAI = c("No", "No", "Opcional", "Sí", "Sí", "Sí", "Sí")
)

print(interpretabilidad)
             Modelo Interpretabilidad Rendimiento Necesita_XAI
1  Regresión Lineal              Alta  Bajo-Medio           No
2 Árbol de Decisión              Alta       Medio           No
3       Naive Bayes             Media       Medio     Opcional
4              k-NN              Baja  Medio-Alto           Sí
5     Random Forest              Baja        Alto           Sí
6               SVM          Muy Baja        Alto           Sí
7  Redes Neuronales          Muy Baja    Muy Alto           Sí

Paradoja de Interpretabilidad-Rendimiento: Los modelos más precisos (Random Forest, XGBoost, Deep Learning) suelen ser menos interpretables. ¡Por eso necesitamos XAI!


2 DATASET Y PREPARACIÓN

Usaremos el dataset Wine Quality para predecir la calidad del vino basándonos en propiedades fisicoquímicas.

2.1 Carga y Exploración

# Cargar dataset de vinos tintos
url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-red.csv"
wine <- read.csv(url, sep = ";")

cat("=== ESTRUCTURA DEL DATASET ===\n")
=== ESTRUCTURA DEL DATASET ===
str(wine)
'data.frame':   1599 obs. of  12 variables:
 $ fixed.acidity       : num  7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
 $ volatile.acidity    : num  0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
 $ citric.acid         : num  0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
 $ residual.sugar      : num  1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
 $ chlorides           : num  0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
 $ free.sulfur.dioxide : num  11 25 15 17 11 13 15 15 9 17 ...
 $ total.sulfur.dioxide: num  34 67 54 60 34 40 59 21 18 102 ...
 $ density             : num  0.998 0.997 0.997 0.998 0.998 ...
 $ pH                  : num  3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
 $ sulphates           : num  0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
 $ alcohol             : num  9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
 $ quality             : int  5 5 5 6 5 5 5 7 7 5 ...
cat("\n=== PRIMERAS FILAS ===\n")

=== PRIMERAS FILAS ===
head(wine)
cat("\n=== RESUMEN ESTADÍSTICO ===\n")

=== RESUMEN ESTADÍSTICO ===
summary(wine)
 fixed.acidity   volatile.acidity  citric.acid    residual.sugar  
 Min.   : 4.60   Min.   :0.1200   Min.   :0.000   Min.   : 0.900  
 1st Qu.: 7.10   1st Qu.:0.3900   1st Qu.:0.090   1st Qu.: 1.900  
 Median : 7.90   Median :0.5200   Median :0.260   Median : 2.200  
 Mean   : 8.32   Mean   :0.5278   Mean   :0.271   Mean   : 2.539  
 3rd Qu.: 9.20   3rd Qu.:0.6400   3rd Qu.:0.420   3rd Qu.: 2.600  
 Max.   :15.90   Max.   :1.5800   Max.   :1.000   Max.   :15.500  
   chlorides       free.sulfur.dioxide total.sulfur.dioxide    density      
 Min.   :0.01200   Min.   : 1.00       Min.   :  6.00       Min.   :0.9901  
 1st Qu.:0.07000   1st Qu.: 7.00       1st Qu.: 22.00       1st Qu.:0.9956  
 Median :0.07900   Median :14.00       Median : 38.00       Median :0.9968  
 Mean   :0.08747   Mean   :15.87       Mean   : 46.47       Mean   :0.9967  
 3rd Qu.:0.09000   3rd Qu.:21.00       3rd Qu.: 62.00       3rd Qu.:0.9978  
 Max.   :0.61100   Max.   :72.00       Max.   :289.00       Max.   :1.0037  
       pH          sulphates         alcohol         quality     
 Min.   :2.740   Min.   :0.3300   Min.   : 8.40   Min.   :3.000  
 1st Qu.:3.210   1st Qu.:0.5500   1st Qu.: 9.50   1st Qu.:5.000  
 Median :3.310   Median :0.6200   Median :10.20   Median :6.000  
 Mean   :3.311   Mean   :0.6581   Mean   :10.42   Mean   :5.636  
 3rd Qu.:3.400   3rd Qu.:0.7300   3rd Qu.:11.10   3rd Qu.:6.000  
 Max.   :4.010   Max.   :2.0000   Max.   :14.90   Max.   :8.000  
# Convertir quality a factor para clasificación
# Simplificamos en 3 categorías: Baja (3-5), Media (6), Alta (7-8)
wine <- wine %>%
  mutate(quality_class = case_when(
    quality <= 5 ~ "Baja",
    quality == 6 ~ "Media",
    quality >= 7 ~ "Alta"
  )) %>%
  mutate(quality_class = factor(quality_class, levels = c("Baja", "Media", "Alta")))

cat("\n=== DISTRIBUCIÓN DE CALIDAD ===\n")

=== DISTRIBUCIÓN DE CALIDAD ===
table(wine$quality_class)

 Baja Media  Alta 
  744   638   217 
# Visualizar distribución
ggplot(wine, aes(x = quality_class, fill = quality_class)) +
  geom_bar() +
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.5) +
  labs(title = "Distribución de Calidad del Vino",
       x = "Calidad", y = "Frecuencia") +
  theme_minimal() +
  scale_fill_manual(values = c("Baja" = "#d73027", "Media" = "#fee08b", "Alta" = "#1a9850"))

2.1.1 Ejercicio 1.1: Exploración

Pregunta 1: ¿El dataset está balanceado? ¿Cómo podría afectar esto a la interpretabilidad?

Pregunta 2: ¿Qué variables crees que serán más importantes para predecir la calidad? (Hipótesis inicial)

2.2 Análisis Exploratorio de Variables

# Correlaciones
cat("=== MATRIZ DE CORRELACIONES ===\n")
=== MATRIZ DE CORRELACIONES ===
correlaciones <- cor(wine[, 1:11])
print(round(correlaciones, 2))
                     fixed.acidity volatile.acidity citric.acid residual.sugar
fixed.acidity                 1.00            -0.26        0.67           0.11
volatile.acidity             -0.26             1.00       -0.55           0.00
citric.acid                   0.67            -0.55        1.00           0.14
residual.sugar                0.11             0.00        0.14           1.00
chlorides                     0.09             0.06        0.20           0.06
free.sulfur.dioxide          -0.15            -0.01       -0.06           0.19
total.sulfur.dioxide         -0.11             0.08        0.04           0.20
density                       0.67             0.02        0.36           0.36
pH                           -0.68             0.23       -0.54          -0.09
sulphates                     0.18            -0.26        0.31           0.01
alcohol                      -0.06            -0.20        0.11           0.04
                     chlorides free.sulfur.dioxide total.sulfur.dioxide density
fixed.acidity             0.09               -0.15                -0.11    0.67
volatile.acidity          0.06               -0.01                 0.08    0.02
citric.acid               0.20               -0.06                 0.04    0.36
residual.sugar            0.06                0.19                 0.20    0.36
chlorides                 1.00                0.01                 0.05    0.20
free.sulfur.dioxide       0.01                1.00                 0.67   -0.02
total.sulfur.dioxide      0.05                0.67                 1.00    0.07
density                   0.20               -0.02                 0.07    1.00
pH                       -0.27                0.07                -0.07   -0.34
sulphates                 0.37                0.05                 0.04    0.15
alcohol                  -0.22               -0.07                -0.21   -0.50
                        pH sulphates alcohol
fixed.acidity        -0.68      0.18   -0.06
volatile.acidity      0.23     -0.26   -0.20
citric.acid          -0.54      0.31    0.11
residual.sugar       -0.09      0.01    0.04
chlorides            -0.27      0.37   -0.22
free.sulfur.dioxide   0.07      0.05   -0.07
total.sulfur.dioxide -0.07      0.04   -0.21
density              -0.34      0.15   -0.50
pH                    1.00     -0.20    0.21
sulphates            -0.20      1.00    0.09
alcohol               0.21      0.09    1.00
# Visualizar correlaciones
library(corrplot)
corrplot(correlaciones, method = "color", type = "upper", 
         tl.col = "black", tl.srt = 45,
         title = "Correlaciones entre Variables Fisicoquímicas",
         mar = c(0,0,2,0))

# Boxplots por calidad
wine_long <- wine %>%
  dplyr::select(-quality) %>%
  pivot_longer(cols = -quality_class, names_to = "Variable", values_to = "Valor")

ggplot(wine_long %>% filter(Variable %in% c("alcohol", "volatile.acidity", 
                                             "sulphates", "citric.acid")), 
       aes(x = quality_class, y = Valor, fill = quality_class)) +
  geom_boxplot() +
  facet_wrap(~Variable, scales = "free_y", ncol = 2) +
  labs(title = "Distribución de Variables Clave por Calidad",
       x = "Calidad", y = "Valor") +
  theme_minimal() +
  scale_fill_manual(values = c("Baja" = "#d73027", "Media" = "#fee08b", "Alta" = "#1a9850"))

2.3 Partición de Datos

# Partición Train (70%) - Test (30%)
set.seed(42)
train_idx <- createDataPartition(wine$quality_class, p = 0.7, list = FALSE)

train_data <- wine[train_idx, ]
test_data <- wine[-train_idx, ]

cat("Tamaño Train:", nrow(train_data), "\n")
Tamaño Train: 1120 
cat("Tamaño Test:", nrow(test_data), "\n\n")
Tamaño Test: 479 
cat("Distribución en Train:\n")
Distribución en Train:
print(table(train_data$quality_class))

 Baja Media  Alta 
  521   447   152 
cat("\nDistribución en Test:\n")

Distribución en Test:
print(table(test_data$quality_class))

 Baja Media  Alta 
  223   191    65 

3 MODELO BASE: RANDOM FOREST

Entrenaremos un Random Forest como nuestro modelo “caja negra” a explicar.

3.1 Entrenamiento del Modelo

cat("=== ENTRENANDO RANDOM FOREST ===\n\n")
=== ENTRENANDO RANDOM FOREST ===
# Preparar datos (eliminar quality y quality_class para features)
X_train <- train_data %>% dplyr::select(-quality, -quality_class)
y_train <- train_data$quality_class

X_test <- test_data %>% dplyr::select(-quality, -quality_class)
y_test <- test_data$quality_class

# Entrenar Random Forest
rf_model <- randomForest(
  x = X_train,
  y = y_train,
  ntree = 500,
  mtry = 3,
  importance = TRUE,
  proximity = TRUE
)

print(rf_model)

Call:
 randomForest(x = X_train, y = y_train, ntree = 500, mtry = 3,      importance = TRUE, proximity = TRUE) 
               Type of random forest: classification
                     Number of trees: 500
No. of variables tried at each split: 3

        OOB estimate of  error rate: 28.48%
Confusion matrix:
      Baja Media Alta class.error
Baja   422    94    5   0.1900192
Media  121   292   34   0.3467562
Alta     6    59   87   0.4276316
# Predicciones en Test
rf_pred <- predict(rf_model, X_test)

# Matriz de confusión
cm <- confusionMatrix(rf_pred, y_test)
print(cm)
Confusion Matrix and Statistics

          Reference
Prediction Baja Media Alta
     Baja   178    45    3
     Media   44   132   30
     Alta     1    14   32

Overall Statistics
                                          
               Accuracy : 0.714           
                 95% CI : (0.6712, 0.7541)
    No Information Rate : 0.4656          
    P-Value [Acc > NIR] : < 2e-16         
                                          
                  Kappa : 0.5197          
                                          
 Mcnemar's Test P-Value : 0.07754         

Statistics by Class:

                     Class: Baja Class: Media Class: Alta
Sensitivity               0.7982       0.6911     0.49231
Specificity               0.8125       0.7431     0.96377
Pos Pred Value            0.7876       0.6408     0.68085
Neg Pred Value            0.8221       0.7839     0.92361
Prevalence                0.4656       0.3987     0.13570
Detection Rate            0.3716       0.2756     0.06681
Detection Prevalence      0.4718       0.4301     0.09812
Balanced Accuracy         0.8054       0.7171     0.72804
cat("\n=== RENDIMIENTO DEL MODELO ===\n")

=== RENDIMIENTO DEL MODELO ===
cat("Accuracy:", round(cm$overall["Accuracy"], 4), "\n")
Accuracy: 0.714 
cat("Kappa:", round(cm$overall["Kappa"], 4), "\n")
Kappa: 0.5197 

3.1.1 Ejercicio 2.1: Evaluación básica

Pregunta 3: ¿El modelo tiene buen rendimiento? ¿En qué clase comete más errores?

Pregunta 4: Sin técnicas de explicabilidad, ¿podrías decir POR QUÉ el modelo clasifica un vino como “Alta” calidad?


4 EXPLICABILIDAD GLOBAL

4.1 4.1 Importancia de Variables

La técnica más básica: ¿qué variables usa más el modelo?

cat("=== IMPORTANCIA DE VARIABLES ===\n\n")
=== IMPORTANCIA DE VARIABLES ===
# Extraer importancia
importancia <- importance(rf_model)
print(round(importancia, 2))
                      Baja Media  Alta MeanDecreaseAccuracy MeanDecreaseGini
fixed.acidity        17.15 15.06 17.29                29.20            49.84
volatile.acidity     37.36 17.08 35.79                48.53            76.48
citric.acid          18.47 14.16 21.12                29.85            50.43
residual.sugar       15.37 14.22 12.95                24.53            43.56
chlorides            18.98 14.01 14.50                27.01            53.73
free.sulfur.dioxide  16.96 18.64 17.10                29.92            45.44
total.sulfur.dioxide 30.20 24.27 24.71                42.30            67.33
density              19.24 18.62 23.54                33.86            61.01
pH                   15.68 14.03 17.22                26.14            48.20
sulphates            28.44 26.16 37.24                47.10            77.10
alcohol              54.67 29.08 44.99                66.54           104.89
# Crear dataframe para visualización
importancia_df <- data.frame(
  Variable = rownames(importancia),
  MeanDecreaseAccuracy = importancia[, "MeanDecreaseAccuracy"],
  MeanDecreaseGini = importancia[, "MeanDecreaseGini"]
) %>%
  arrange(desc(MeanDecreaseAccuracy))

print(importancia_df)
                                 Variable MeanDecreaseAccuracy MeanDecreaseGini
alcohol                           alcohol             66.53504        104.89330
volatile.acidity         volatile.acidity             48.53061         76.48233
sulphates                       sulphates             47.10150         77.09623
total.sulfur.dioxide total.sulfur.dioxide             42.29507         67.32926
density                           density             33.85747         61.00504
free.sulfur.dioxide   free.sulfur.dioxide             29.91570         45.43624
citric.acid                   citric.acid             29.84695         50.42914
fixed.acidity               fixed.acidity             29.19874         49.83582
chlorides                       chlorides             27.01004         53.72607
pH                                     pH             26.13625         48.20294
residual.sugar             residual.sugar             24.52589         43.55727
# Visualizar
p1 <- ggplot(importancia_df, aes(x = reorder(Variable, MeanDecreaseAccuracy), 
                                  y = MeanDecreaseAccuracy)) +
  geom_col(fill = "steelblue") +
  coord_flip() +
  labs(title = "Importancia de Variables (Mean Decrease Accuracy)",
       subtitle = "Mayor valor = más importante para la precisión",
       x = NULL, y = "Mean Decrease Accuracy") +
  theme_minimal()

p2 <- ggplot(importancia_df, aes(x = reorder(Variable, MeanDecreaseGini), 
                                  y = MeanDecreaseGini)) +
  geom_col(fill = "darkorange") +
  coord_flip() +
  labs(title = "Importancia de Variables (Mean Decrease Gini)",
       subtitle = "Mayor valor = más importante para la pureza de nodos",
       x = NULL, y = "Mean Decrease Gini") +
  theme_minimal()

grid.arrange(p1, p2, ncol = 1)

4.1.1 Interpretación

  • Mean Decrease Accuracy: Si permuto esta variable aleatoriamente, ¿cuánto baja la accuracy?
  • Mean Decrease Gini: ¿Cuánto contribuye esta variable a la pureza de los nodos?

IMPORTANTE: Importancia de variables puede ser engañosa con variables correlacionadas.

4.1.2 Ejercicio 4.1: Importancia

Pregunta 5: ¿Cuáles son las 3 variables más importantes según ambas métricas?

Pregunta 6: ¿Coinciden con tu hipótesis inicial de la Pregunta 2?

4.2 4.2 Partial Dependence Plots (PDP)

Los PDPs muestran cómo cambia la predicción cuando cambia una variable, manteniendo las demás constantes (promediadas).

cat("=== PARTIAL DEPENDENCE PLOTS ===\n\n")
=== PARTIAL DEPENDENCE PLOTS ===
# Seleccionar las 4 variables más importantes
top_vars <- importancia_df$Variable[1:4]

cat("Analizando variables:", paste(top_vars, collapse = ", "), "\n\n")
Analizando variables: alcohol, volatile.acidity, sulphates, total.sulfur.dioxide 
# Crear PDPs para las top 4 variables
pdp_plots <- list()

for(var in top_vars) {
  # Calcular partial dependence
  pd <- partial(rf_model, pred.var = var, train = X_train, 
                type = "classification", which.class = "Alta",
                prob = TRUE, plot = FALSE)
  
  # Crear plot
  p <- ggplot(pd, aes_string(x = var, y = "yhat")) +
    geom_line(color = "darkgreen", size = 1.2) +
    geom_smooth(se = TRUE, alpha = 0.2) +
    labs(title = paste("PDP:", var),
         x = var, y = "Prob. Calidad = Alta") +
    theme_minimal()
  
  pdp_plots[[var]] <- p
}

# Mostrar en grid
do.call(grid.arrange, c(pdp_plots, ncol = 2))

4.2.1 Interpretación de PDPs

  • Línea ascendente: A mayor valor de la variable, mayor probabilidad de la clase
  • Línea descendente: A mayor valor, menor probabilidad
  • Línea plana: La variable no afecta mucho la predicción
  • No lineal: Relación compleja (umbrales, forma de U, etc.)

4.2.2 Ejercicio 4.2: PDPs

Pregunta 7: ¿Qué relación tiene el alcohol con la calidad alta? ¿Es lineal?

Pregunta 8: ¿Hay alguna variable con efecto de umbral (cambia drásticamente en cierto punto)?

4.3 4.3 Interacciones entre Variables (ICE plots y PDP 2D)

Las interacciones ocurren cuando el efecto de una variable depende del valor de otra.

cat("=== ANÁLISIS DE INTERACCIONES ===\n\n")
=== ANÁLISIS DE INTERACCIONES ===
# PDP 2D para las dos variables más importantes
top2_vars <- importancia_df$Variable[1:2]

cat("Analizando interacción:", top2_vars[1], "y", top2_vars[2], "\n\n")
Analizando interacción: alcohol y volatile.acidity 
# Partial dependence 2D
pd_2d <- partial(rf_model, pred.var = top2_vars, train = X_train,
                 type = "classification", which.class = "Alta",
                 prob = TRUE, chull = TRUE, plot = FALSE)

# Visualizar
ggplot(pd_2d, aes_string(x = top2_vars[1], y = top2_vars[2], fill = "yhat")) +
  geom_tile() +
  scale_fill_viridis_c(option = "plasma") +
  labs(title = paste("Interacción:", top2_vars[1], "×", top2_vars[2]),
       subtitle = "Probabilidad de Calidad = Alta",
       fill = "Prob.") +
  theme_minimal()

# ICE Plots (Individual Conditional Expectation)
# Muestra cómo cada observación individual cambia con una variable
cat("\n=== ICE PLOTS (Individual Conditional Expectation) ===\n\n")

=== ICE PLOTS (Individual Conditional Expectation) ===
# Usar librería iml para ICE plots
# Crear predictor
predictor <- Predictor$new(
  model = rf_model, 
  data = X_train, 
  y = y_train,
  type = "prob"
)

# ICE plot para la variable más importante
var_top <- top_vars[1]
ice <- FeatureEffect$new(predictor, feature = var_top, method = "pdp+ice")

# Plot
plot(ice) +
  labs(title = paste("ICE Plot:", var_top),
       subtitle = "Líneas grises = observaciones individuales, Línea amarilla = promedio (PDP)") +
  theme_minimal()

4.3.1 Ejercicio 4.3: Interacciones

Pregunta 9: ¿Hay interacción visible entre las dos variables principales?

Pregunta 10: En los ICE plots, ¿todas las observaciones siguen la misma tendencia o hay heterogeneidad?


5 EXPLICABILIDAD LOCAL

5.1 5.1 LIME (Local Interpretable Model-agnostic Explanations)

LIME explica una predicción específica ajustando un modelo simple (lineal) localmente alrededor de esa observación.

5.1.1 Concepto de LIME

  1. Selecciona una observación a explicar
  2. Genera datos sintéticos similares (perturbaciones)
  3. Predice con el modelo complejo en esos datos
  4. Ajusta un modelo simple (lineal) localmente
  5. El modelo simple explica la predicción local
cat("=== LIME: EXPLICACIONES LOCALES ===\n\n")
=== LIME: EXPLICACIONES LOCALES ===
# Necesitamos una función de predicción que devuelva probabilidades
predict_function <- function(model, newdata) {
  predict(model, newdata, type = "prob")
}

# Crear explainer de LIME usando iml
explainer_lime <- LocalModel$new(predictor, x.interest = X_test[1, ], k = 5)

# Explicación de la primera observación del test
cat("OBSERVACIÓN A EXPLICAR:\n")
OBSERVACIÓN A EXPLICAR:
print(X_test[1, ])
  fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
1           7.4              0.7           0            1.9     0.076
  free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
1                  11                   34  0.9978 3.51      0.56     9.4
cat("\nPREDICCIÓN DEL MODELO:\n")

PREDICCIÓN DEL MODELO:
pred_prob <- predict(rf_model, X_test[1, ], type = "prob")
print(pred_prob)
   Baja Media Alta
1 0.854 0.136 0.01
attr(,"class")
[1] "matrix" "array"  "votes" 
cat("\nClase predicha:", as.character(rf_pred[1]), "\n\n")

Clase predicha: Baja 
# Visualizar explicación
plot(explainer_lime) +
  labs(title = "LIME: Explicación Local (Observación 1)",
       subtitle = paste("Predicción:", rf_pred[1])) +
  theme_minimal()

cat("\nRESULTADOS LIME:\n")

RESULTADOS LIME:
print(explainer_lime$results)
            beta x.recoded        effect x.original              feature
1  -0.0009509900      7.40 -0.0070373257        7.4        fixed.acidity
2   1.8634969401      0.70  1.3044478581        0.7     volatile.acidity
3   0.0037935291     34.00  0.1289799902         34 total.sulfur.dioxide
4  -0.7227726547      0.56 -0.4047526866       0.56            sulphates
5  -0.5757261235      9.40 -5.4118255611        9.4              alcohol
6  -0.0001022999      7.40 -0.0007570195        7.4        fixed.acidity
7  -0.1546773060      0.70 -0.1082741142        0.7     volatile.acidity
8  -0.0015605856     34.00 -0.0530599089         34 total.sulfur.dioxide
9  -0.1026342580      0.56 -0.0574751845       0.56            sulphates
10  0.0347315974      9.40  0.3264770158        9.4              alcohol
11  0.0010532899      7.40  0.0077943452        7.4        fixed.acidity
12 -1.7088196342      0.70 -1.1961737439        0.7     volatile.acidity
13 -0.0022329436     34.00 -0.0759200812         34 total.sulfur.dioxide
14  0.8254069127      0.56  0.4622278711       0.56            sulphates
15  0.5409945261      9.40  5.0853485454        9.4              alcohol
             feature.value .class
1        fixed.acidity=7.4   Baja
2     volatile.acidity=0.7   Baja
3  total.sulfur.dioxide=34   Baja
4           sulphates=0.56   Baja
5              alcohol=9.4   Baja
6        fixed.acidity=7.4  Media
7     volatile.acidity=0.7  Media
8  total.sulfur.dioxide=34  Media
9           sulphates=0.56  Media
10             alcohol=9.4  Media
11       fixed.acidity=7.4   Alta
12    volatile.acidity=0.7   Alta
13 total.sulfur.dioxide=34   Alta
14          sulphates=0.56   Alta
15             alcohol=9.4   Alta

5.1.2 Explicar múltiples observaciones

# Explicar algunas observaciones interesantes

# Función para explicar y visualizar
explicar_observacion <- function(idx, datos, modelo, predictor_obj) {
  cat("\n━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n")
  cat("OBSERVACIÓN", idx, "\n")
  cat("━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n")
  
  # Mostrar valores
  cat("\nValores de las variables:\n")
  print(datos[idx, ])
  
  # Predicción
  pred_prob <- predict(modelo, datos[idx, ], type = "prob")
  cat("\nProbabilidades predichas:\n")
  print(pred_prob)
  
  # Clase predicha
  pred_class <- predict(modelo, datos[idx, ])
  cat("\nClase predicha:", as.character(pred_class), "\n")
  
  # LIME
  lime_local <- LocalModel$new(predictor_obj, x.interest = datos[idx, ], k = 5)
  
  p <- plot(lime_local) +
    labs(title = paste("LIME - Observación", idx),
         subtitle = paste("Predicción:", pred_class)) +
    theme_minimal()
  
  print(p)
  
  return(lime_local)
}

# Explicar 3 observaciones diferentes
obs_indices <- c(1, 50, 100)

for(idx in obs_indices) {
  explicar_observacion(idx, X_test, rf_model, predictor)
}

━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
OBSERVACIÓN 1 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

Valores de las variables:
  fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
1           7.4              0.7           0            1.9     0.076
  free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
1                  11                   34  0.9978 3.51      0.56     9.4

Probabilidades predichas:
   Baja Media Alta
1 0.854 0.136 0.01
attr(,"class")
[1] "matrix" "array"  "votes" 

Clase predicha: Baja 


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
OBSERVACIÓN 50 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

Valores de las variables:
    fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
140           7.8             0.56        0.19              2     0.081
    free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
140                  17                  108  0.9962 3.32      0.54     9.5

Probabilidades predichas:
     Baja Media Alta
140 0.852 0.148    0
attr(,"class")
[1] "matrix" "array"  "votes" 

Clase predicha: Baja 


━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
OBSERVACIÓN 100 
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

Valores de las variables:
    fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
360          12.6             0.38        0.66            2.6     0.088
    free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
360                  10                   41   1.001 3.17      0.68     9.8

Probabilidades predichas:
     Baja Media  Alta
360 0.366 0.466 0.168
attr(,"class")
[1] "matrix" "array"  "votes" 

Clase predicha: Media 

5.1.3 Ejercicio 5.1: LIME

Pregunta 11: ¿Las variables importantes cambian entre diferentes observaciones?

Pregunta 12: ¿LIME ayuda a entender POR QUÉ el modelo hizo una predicción específica?

5.2 5.2 SHAPLEY Values

Los valores SHAPLEY vienen de la teoría de juegos y distribuyen el “crédito” de una predicción entre las variables de forma justa.

5.2.1 Concepto de SHAPLEY

  • Mide la contribución marginal de cada variable
  • Considera todas las combinaciones posibles de variables
  • Propiedades matemáticas deseables (eficiencia, simetría, etc.)
  • Más robusto que LIME pero más costoso computacionalmente
cat("=== SHAPLEY VALUES ===\n\n")
=== SHAPLEY VALUES ===
# Usar iml para calcular Shapley values
shapley_explainer <- Shapley$new(predictor, x.interest = X_test[1, ])

cat("SHAPLEY VALUES para Observación 1:\n")
SHAPLEY VALUES para Observación 1:
print(shapley_explainer$results)
                feature class      phi      phi.var           feature.value
1         fixed.acidity  Baja  0.02118 0.0036909168       fixed.acidity=7.4
2      volatile.acidity  Baja  0.17704 0.0265789479    volatile.acidity=0.7
3           citric.acid  Baja -0.00208 0.0032528420           citric.acid=0
4        residual.sugar  Baja -0.00066 0.0010898630      residual.sugar=1.9
5             chlorides  Baja  0.02222 0.0020237491         chlorides=0.076
6   free.sulfur.dioxide  Baja -0.00366 0.0016273176  free.sulfur.dioxide=11
7  total.sulfur.dioxide  Baja -0.02356 0.0040679257 total.sulfur.dioxide=34
8               density  Baja  0.03434 0.0028551156          density=0.9978
9                    pH  Baja  0.01816 0.0017321762                 pH=3.51
10            sulphates  Baja  0.04726 0.0154255883          sulphates=0.56
11              alcohol  Baja  0.16850 0.0341441111             alcohol=9.4
12        fixed.acidity Media -0.02348 0.0031202925       fixed.acidity=7.4
13     volatile.acidity Media -0.14284 0.0297042570    volatile.acidity=0.7
14          citric.acid Media  0.01084 0.0042249034           citric.acid=0
15       residual.sugar Media  0.00276 0.0013704065      residual.sugar=1.9
16            chlorides Media -0.02114 0.0018945661         chlorides=0.076
17  free.sulfur.dioxide Media  0.00150 0.0018232222  free.sulfur.dioxide=11
18 total.sulfur.dioxide Media  0.01452 0.0047445349 total.sulfur.dioxide=34
19              density Media -0.02562 0.0036706016          density=0.9978
20                   pH Media -0.01464 0.0017515055                 pH=3.51
21            sulphates Media -0.01668 0.0150461592          sulphates=0.56
22              alcohol Media -0.11276 0.0278816792             alcohol=9.4
23        fixed.acidity  Alta  0.00230 0.0002023737       fixed.acidity=7.4
24     volatile.acidity  Alta -0.03420 0.0075810505    volatile.acidity=0.7
25          citric.acid  Alta -0.00876 0.0019801842           citric.acid=0
26       residual.sugar  Alta -0.00210 0.0004656465      residual.sugar=1.9
27            chlorides  Alta -0.00108 0.0002848016         chlorides=0.076
28  free.sulfur.dioxide  Alta  0.00216 0.0004942772  free.sulfur.dioxide=11
29 total.sulfur.dioxide  Alta  0.00904 0.0012144226 total.sulfur.dioxide=34
30              density  Alta -0.00872 0.0017829107          density=0.9978
31                   pH  Alta -0.00352 0.0004872016                 pH=3.51
32            sulphates  Alta -0.03058 0.0086754178          sulphates=0.56
33              alcohol  Alta -0.05574 0.0087389620             alcohol=9.4
# Visualizar
plot(shapley_explainer) +
  labs(title = "Shapley Values - Observación 1",
       subtitle = paste("Predicción:", rf_pred[1])) +
  theme_minimal()

5.2.2 Comparación LIME vs SHAPLEY

cat("=== COMPARACIÓN LIME vs SHAPLEY ===\n\n")
=== COMPARACIÓN LIME vs SHAPLEY ===
# Para la misma observación
idx <- 1

# LIME
lime_exp <- LocalModel$new(predictor, x.interest = X_test[idx, ], k = 5)
lime_results <- lime_exp$results %>%
  arrange(desc(abs(effect))) %>%
  head(5) %>%
  mutate(Metodo = "LIME")

# SHAPLEY
shap_exp <- Shapley$new(predictor, x.interest = X_test[idx, ])
shap_results <- shap_exp$results %>%
  arrange(desc(abs(phi))) %>%
  head(5) %>%
  dplyr::select(feature.value, phi) %>%
  rename(effect = phi) %>%
  mutate(Metodo = "SHAPLEY")

cat("Top 5 variables según LIME:\n")
Top 5 variables según LIME:
print(lime_results %>% dplyr::select(feature.value, effect))
         feature.value     effect
1          alcohol=9.4 -5.4118256
2          alcohol=9.4  5.0853485
3 volatile.acidity=0.7  1.3044479
4 volatile.acidity=0.7 -1.1961737
5       sulphates=0.56  0.4622279
cat("\nTop 5 variables según SHAPLEY:\n")

Top 5 variables según SHAPLEY:
print(shap_results %>% dplyr::select(feature.value, effect))
         feature.value   effect
1          alcohol=9.4  0.20576
2 volatile.acidity=0.7  0.15082
3          alcohol=9.4 -0.13924
4 volatile.acidity=0.7 -0.12032
5          alcohol=9.4 -0.06652
# Visualización comparativa
p1 <- plot(lime_exp) + 
  labs(title = "LIME") + 
  theme_minimal()

p2 <- plot(shap_exp) + 
  labs(title = "SHAPLEY") + 
  theme_minimal()

grid.arrange(p1, p2, ncol = 2)

5.2.3 Ejercicio 5.2: SHAPLEY

Pregunta 13: ¿LIME y SHAPLEY dan explicaciones similares o diferentes?

Pregunta 14: ¿Cuál de las dos técnicas te parece más confiable y por qué?


6 EXPLICABILIDAD CON DALEX

DALEX (Descriptive mAchine Learning EXplanations) es un framework completo para explicabilidad.

6.1 6.1 Crear Explainer DALEX

cat("=== DALEX: Framework Completo ===\n\n")
=== DALEX: Framework Completo ===
# Crear explainer
# Para clasificación multiclase, y debe ser el factor original
explainer_dalex <- DALEX::explain(
  model = rf_model,
  data = X_test,
  y = y_test,
  label = "Random Forest",
  predict_function = function(model, newdata) {
    predict(model, newdata, type = "prob")
  }
)
Preparation of a new explainer is initiated
  -> model label       :  Random Forest 
  -> data              :  479  rows  11  cols 
  -> target variable   :  479  values 
  -> predict function  :  function(model, newdata) {     predict(model, newdata, type = "prob") } 
  -> predicted values  :  No value for predict function target column. (  default  )
  -> model_info        :  package randomForest , ver. 4.7.1.2 , task multiclass (  default  ) 
  -> predicted values  :  predict function returns multiple columns:  3  (  default  ) 
  -> residual function :  difference between 1 and probability of true class (  default  )
  -> residuals         :  numerical, min =  0.032 , mean =  0.4114739 , max =  0.968  
  A new explainer has been created!  
print(explainer_dalex)
Model label:  Random Forest 
Model class:  randomForest 
Data head  :
  fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
1           7.4              0.7           0            1.9     0.076
5           7.4              0.7           0            1.9     0.076
  free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
1                  11                   34  0.9978 3.51      0.56     9.4
5                  11                   34  0.9978 3.51      0.56     9.4

6.2 6.2 Model Performance

cat("=== MODEL PERFORMANCE (DALEX) ===\n\n")
=== MODEL PERFORMANCE (DALEX) ===
# Para clasificación multiclase, usamos residuos personalizados
# Calculamos predicciones
preds_dalex <- predict(rf_model, X_test)

# Matriz de confusión
cm_dalex <- confusionMatrix(preds_dalex, y_test)
print(cm_dalex)
Confusion Matrix and Statistics

          Reference
Prediction Baja Media Alta
     Baja   178    46    3
     Media   44   131   30
     Alta     1    14   32

Overall Statistics
                                          
               Accuracy : 0.7119          
                 95% CI : (0.6691, 0.7521)
    No Information Rate : 0.4656          
    P-Value [Acc > NIR] : < 2e-16         
                                          
                  Kappa : 0.5161          
                                          
 Mcnemar's Test P-Value : 0.07641         

Statistics by Class:

                     Class: Baja Class: Media Class: Alta
Sensitivity               0.7982       0.6859     0.49231
Specificity               0.8086       0.7431     0.96377
Pos Pred Value            0.7841       0.6390     0.68085
Neg Pred Value            0.8214       0.7810     0.92361
Prevalence                0.4656       0.3987     0.13570
Detection Rate            0.3716       0.2735     0.06681
Detection Prevalence      0.4739       0.4280     0.09812
Balanced Accuracy         0.8034       0.7145     0.72804
# Calcular residuos manualmente (1 si acierto, 0 si falla)
residuos <- ifelse(preds_dalex == y_test, 0, 1)

cat("\nTasa de error:", mean(residuos), "\n")

Tasa de error: 0.2881002 
cat("Accuracy:", mean(preds_dalex == y_test), "\n")
Accuracy: 0.7118998 
# Visualizar distribución de aciertos/fallos
df_performance <- data.frame(
  Real = y_test,
  Predicho = preds_dalex,
  Correcto = preds_dalex == y_test
)

ggplot(df_performance, aes(x = Real, fill = Correcto)) +
  geom_bar(position = "fill") +
  labs(title = "Proporción de Aciertos por Clase",
       y = "Proporción", x = "Clase Real") +
  scale_fill_manual(values = c("FALSE" = "#d73027", "TRUE" = "#1a9850")) +
  theme_minimal()

6.3 6.3 Variable Importance (DALEX)

cat("=== VARIABLE IMPORTANCE (DALEX) ===\n\n")
=== VARIABLE IMPORTANCE (DALEX) ===
# Calcular importancia mediante permutación
vi <- model_parts(explainer_dalex, type = "difference")

print(vi)
               variable mean_dropout_loss         label
1          _full_model_           0.00000 Random Forest
2   free.sulfur.dioxide          10.81248 Random Forest
3             chlorides          11.33390 Random Forest
4                    pH          11.81109 Random Forest
5        residual.sugar          12.09395 Random Forest
6         fixed.acidity          13.53531 Random Forest
7           citric.acid          14.51380 Random Forest
8               density          21.29089 Random Forest
9  total.sulfur.dioxide          31.92144 Random Forest
10     volatile.acidity          33.51832 Random Forest
11            sulphates          50.64681 Random Forest
12              alcohol          83.90527 Random Forest
13           _baseline_         373.68653 Random Forest
plot(vi) +
  labs(title = "Importancia de Variables (DALEX)",
       subtitle = "Basado en permutación - pérdida de performance") +
  theme_minimal()

6.4 6.4 Partial Dependence (DALEX)

cat("=== PARTIAL DEPENDENCE (DALEX) ===\n\n")
=== PARTIAL DEPENDENCE (DALEX) ===
# PDP para las variables más importantes
# Especificamos la clase de interés ("Alta")
pdp_alcohol <- model_profile(explainer_dalex, 
                              variables = "alcohol",
                              type = "partial")

pdp_sulphates <- model_profile(explainer_dalex, 
                                variables = "sulphates",
                                type = "partial")

pdp_volatile <- model_profile(explainer_dalex, 
                               variables = "volatile.acidity",
                               type = "partial")

# Plot
p1 <- plot(pdp_alcohol) + 
  labs(title = "PDP: Alcohol") +
  theme_minimal()

p2 <- plot(pdp_sulphates) + 
  labs(title = "PDP: Sulphates") +
  theme_minimal()

p3 <- plot(pdp_volatile) + 
  labs(title = "PDP: Volatile Acidity") +
  theme_minimal()

grid.arrange(p1, p2, p3, ncol = 1)

6.5 6.5 Break Down (similar a SHAPLEY)

cat("=== BREAK DOWN PLOTS (DALEX) ===\n\n")
=== BREAK DOWN PLOTS (DALEX) ===
# Para observación específica
bd <- predict_parts(explainer_dalex, new_observation = X_test[1, ], 
                    type = "break_down")

print(bd)
                                               contribution
Random Forest.Baja: intercept                         0.452
Random Forest.Baja: alcohol = 9.4                     0.139
Random Forest.Baja: volatile.acidity = 0.7            0.115
Random Forest.Baja: sulphates = 0.56                  0.021
Random Forest.Baja: total.sulfur.dioxide = 34        -0.021
Random Forest.Baja: citric.acid = 0                   0.002
Random Forest.Baja: density = 0.9978                  0.035
Random Forest.Baja: pH = 3.51                         0.018
Random Forest.Baja: fixed.acidity = 7.4               0.032
Random Forest.Baja: residual.sugar = 1.9              0.004
Random Forest.Baja: chlorides = 0.076                 0.047
Random Forest.Baja: free.sulfur.dioxide = 11          0.010
Random Forest.Baja: prediction                        0.854
Random Forest.Media: intercept                        0.403
Random Forest.Media: alcohol = 9.4                   -0.056
Random Forest.Media: volatile.acidity = 0.7          -0.090
Random Forest.Media: sulphates = 0.56                -0.009
Random Forest.Media: total.sulfur.dioxide = 34        0.020
Random Forest.Media: citric.acid = 0                  0.001
Random Forest.Media: density = 0.9978                -0.028
Random Forest.Media: pH = 3.51                       -0.017
Random Forest.Media: fixed.acidity = 7.4             -0.032
Random Forest.Media: residual.sugar = 1.9            -0.004
Random Forest.Media: chlorides = 0.076               -0.042
Random Forest.Media: free.sulfur.dioxide = 11        -0.012
Random Forest.Media: prediction                       0.136
Random Forest.Alta: intercept                         0.145
Random Forest.Alta: alcohol = 9.4                    -0.083
Random Forest.Alta: volatile.acidity = 0.7           -0.026
Random Forest.Alta: sulphates = 0.56                 -0.013
Random Forest.Alta: total.sulfur.dioxide = 34         0.001
Random Forest.Alta: citric.acid = 0                  -0.003
Random Forest.Alta: density = 0.9978                 -0.007
Random Forest.Alta: pH = 3.51                        -0.001
Random Forest.Alta: fixed.acidity = 7.4               0.000
Random Forest.Alta: residual.sugar = 1.9              0.000
Random Forest.Alta: chlorides = 0.076                -0.005
Random Forest.Alta: free.sulfur.dioxide = 11          0.002
Random Forest.Alta: prediction                        0.010
plot(bd) +
  labs(title = "Break Down - Observación 1",
       subtitle = "Contribución de cada variable a la predicción") +
  theme_minimal()

# Comparar varias observaciones
bd_1 <- predict_parts(explainer_dalex, new_observation = X_test[1, ], 
                      type = "break_down")
bd_50 <- predict_parts(explainer_dalex, new_observation = X_test[50, ], 
                       type = "break_down")
bd_100 <- predict_parts(explainer_dalex, new_observation = X_test[100, ], 
                        type = "break_down")

plot(bd_1, bd_50, bd_100) +
  labs(title = "Comparación Break Down - 3 Observaciones") +
  theme_minimal()

6.5.1 Ejercicio 6.1: DALEX

Pregunta 15: ¿Qué ventajas tiene DALEX sobre usar las técnicas por separado?

Pregunta 16: ¿Los resultados de DALEX coinciden con los de iml (LIME/SHAPLEY)?


7 CASOS DE USO PRÁCTICOS

7.1 7.1 Explicar un Vino de Alta Calidad

cat("=== CASO 1: Explicar un Vino de ALTA Calidad ===\n\n")
=== CASO 1: Explicar un Vino de ALTA Calidad ===
# Buscar un vino de alta calidad bien clasificado
vinos_alta <- which(y_test == "Alta" & rf_pred == "Alta")
idx_alta <- vinos_alta[1]

cat("Observación:", idx_alta, "\n")
Observación: 63 
cat("Valores reales:\n")
Valores reales:
print(X_test[idx_alta, ])
    fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
206          12.8              0.3        0.74            2.6     0.095
    free.sulfur.dioxide total.sulfur.dioxide density  pH sulphates alcohol
206                   9                   28  0.9994 3.2      0.77    10.8
cat("\nClase real:", as.character(y_test[idx_alta]), "\n")

Clase real: Alta 
cat("Predicción:", as.character(rf_pred[idx_alta]), "\n")
Predicción: Alta 
cat("Probabilidades:\n")
Probabilidades:
print(predict(rf_model, X_test[idx_alta, ], type = "prob"))
     Baja Media  Alta
206 0.044  0.12 0.836
attr(,"class")
[1] "matrix" "array"  "votes" 
# Explicación completa
cat("\n--- SHAPLEY Values ---\n")

--- SHAPLEY Values ---
shap_alta <- Shapley$new(predictor, x.interest = X_test[idx_alta, ])
plot(shap_alta) +
  labs(title = "¿Por qué este vino es de ALTA calidad?",
       subtitle = "Contribuciones de cada variable (SHAPLEY)") +
  theme_minimal()

cat("\n--- DALEX Break Down ---\n")

--- DALEX Break Down ---
bd_alta <- predict_parts(explainer_dalex, new_observation = X_test[idx_alta, ],
                         type = "break_down")
plot(bd_alta) +
  labs(title = "Break Down - Vino de Alta Calidad") +
  theme_minimal()

7.2 7.2 Explicar un Error del Modelo

cat("=== CASO 2: Explicar un ERROR del Modelo ===\n\n")
=== CASO 2: Explicar un ERROR del Modelo ===
# Buscar un error: modelo predice Alta pero es Baja (falso positivo)
errores <- which(y_test == "Baja" & rf_pred == "Alta")

if(length(errores) > 0) {
  idx_error <- errores[1]
  
  cat("Observación con ERROR:", idx_error, "\n")
  cat("Valores reales:\n")
  print(X_test[idx_error, ])
  
  cat("\nClase REAL:", as.character(y_test[idx_error]), "\n")
  cat("PREDICCIÓN:", as.character(rf_pred[idx_error]), "❌ ERROR\n")
  cat("Probabilidades:\n")
  print(predict(rf_model, X_test[idx_error, ], type = "prob"))
  
  # ¿Por qué el modelo se equivocó?
  cat("\n--- Análisis del Error ---\n")
  shap_error <- Shapley$new(predictor, x.interest = X_test[idx_error, ])
  plot(shap_error) +
    labs(title = "¿Por qué el modelo predijo ALTA (incorrectamente)?",
         subtitle = paste("Real: Baja | Predicho: Alta")) +
    theme_minimal()
  
  bd_error <- predict_parts(explainer_dalex, new_observation = X_test[idx_error, ],
                            type = "break_down")
  plot(bd_error) +
    labs(title = "Break Down - Error del Modelo",
         subtitle = "Entendiendo el error") +
    theme_minimal()
} else {
  cat("No hay errores de este tipo en el test set (¡el modelo es muy bueno!)\n")
}
Observación con ERROR: 428 
Valores reales:
     fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
1430           7.9             0.18         0.4            2.2     0.049
     free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
1430                  38                   67   0.996 3.33      0.93    11.3

Clase REAL: Baja 
PREDICCIÓN: Alta ❌ ERROR
Probabilidades:
      Baja Media Alta
1430 0.088 0.432 0.48
attr(,"class")
[1] "matrix" "array"  "votes" 

--- Análisis del Error ---

7.3 7.3 Recomendaciones para Mejorar un Vino

cat("=== CASO 3: Recomendaciones para MEJORAR un Vino ===\n\n")
=== CASO 3: Recomendaciones para MEJORAR un Vino ===
# Tomar un vino de calidad Baja y ver qué cambiar para que sea Alta
idx_baja <- which(y_test == "Baja")[1]

cat("Vino de BAJA calidad (observación", idx_baja, "):\n")
Vino de BAJA calidad (observación 1 ):
vino_original <- X_test[idx_baja, ]
print(vino_original)
  fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
1           7.4              0.7           0            1.9     0.076
  free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
1                  11                   34  0.9978 3.51      0.56     9.4
cat("\nPredicción actual:\n")

Predicción actual:
pred_original <- predict(rf_model, vino_original, type = "prob")
print(pred_original)
   Baja Media Alta
1 0.854 0.136 0.01
attr(,"class")
[1] "matrix" "array"  "votes" 
# Usar SHAPLEY para ver qué cambios tendrían más impacto
shap_baja <- Shapley$new(predictor, x.interest = vino_original)

cat("\nContribuciones actuales (SHAPLEY):\n")

Contribuciones actuales (SHAPLEY):
contribuciones <- shap_baja$results %>%
  arrange(desc(abs(phi))) %>%
  dplyr::select(feature, feature.value, phi)
print(contribuciones)
                feature           feature.value      phi
1               alcohol             alcohol=9.4  0.13844
2      volatile.acidity    volatile.acidity=0.7  0.13702
3      volatile.acidity    volatile.acidity=0.7 -0.11888
4               alcohol             alcohol=9.4 -0.10380
5               density          density=0.9978  0.03972
6               density          density=0.9978 -0.03536
7               alcohol             alcohol=9.4 -0.03464
8  total.sulfur.dioxide total.sulfur.dioxide=34  0.02802
9  total.sulfur.dioxide total.sulfur.dioxide=34 -0.02734
10            chlorides         chlorides=0.076  0.02280
11        fixed.acidity       fixed.acidity=7.4  0.02112
12                   pH                 pH=3.51  0.01978
13                   pH                 pH=3.51 -0.01938
14        fixed.acidity       fixed.acidity=7.4 -0.01934
15     volatile.acidity    volatile.acidity=0.7 -0.01814
16            chlorides         chlorides=0.076 -0.01660
17            sulphates          sulphates=0.56 -0.01556
18            sulphates          sulphates=0.56  0.00904
19  free.sulfur.dioxide  free.sulfur.dioxide=11 -0.00728
20          citric.acid           citric.acid=0 -0.00658
21            sulphates          sulphates=0.56  0.00652
22            chlorides         chlorides=0.076 -0.00620
23              density          density=0.9978 -0.00436
24          citric.acid           citric.acid=0  0.00412
25  free.sulfur.dioxide  free.sulfur.dioxide=11  0.00408
26  free.sulfur.dioxide  free.sulfur.dioxide=11  0.00320
27          citric.acid           citric.acid=0  0.00246
28       residual.sugar      residual.sugar=1.9 -0.00184
29        fixed.acidity       fixed.acidity=7.4 -0.00178
30       residual.sugar      residual.sugar=1.9  0.00114
31       residual.sugar      residual.sugar=1.9  0.00070
32 total.sulfur.dioxide total.sulfur.dioxide=34 -0.00068
33                   pH                 pH=3.51 -0.00040
plot(shap_baja) +
  labs(title = "¿Qué impide que este vino sea de Alta calidad?",
       subtitle = "Variables con contribución negativa son oportunidades de mejora") +
  theme_minimal()

# Simular mejoras
cat("\n=== SIMULACIÓN DE MEJORAS ===\n\n")

=== SIMULACIÓN DE MEJORAS ===
# Identificar la variable con mayor contribución negativa hacia "Alta"
var_mejorar <- contribuciones$feature[1]

cat("Variable a mejorar:", var_mejorar, "\n")
Variable a mejorar: alcohol 
cat("Valor actual:", vino_original[[var_mejorar]], "\n")
Valor actual: 9.4 
# Ver el PDP de esa variable para saber en qué dirección cambiar
pdp_mejorar <- model_profile(explainer_dalex, variables = var_mejorar)
plot(pdp_mejorar) +
  labs(title = paste("PDP:", var_mejorar),
       subtitle = "¿Cómo cambiar esta variable?") +
  theme_minimal()

7.3.1 Ejercicio 7.1: Casos prácticos

Pregunta 17: ¿Las explicaciones te ayudan a entender qué hace que un vino sea de alta calidad?

Pregunta 18: ¿Podrías dar recomendaciones concretas a un productor de vinos basándote en las explicaciones?


8 COMPARACIÓN DE TÉCNICAS

8.1 Tabla Resumen

cat("=== COMPARACIÓN DE TÉCNICAS DE EXPLICABILIDAD ===\n\n")
=== COMPARACIÓN DE TÉCNICAS DE EXPLICABILIDAD ===
comparacion_xai <- data.frame(
  Tecnica = c("Feature Importance", "Partial Dependence (PDP)", "ICE Plots", 
              "LIME", "SHAPLEY", "DALEX Break Down"),
  Tipo = c("Global", "Global", "Global/Local", "Local", "Local", "Local"),
  Velocidad = c("Muy Rápida", "Media", "Lenta", "Media", "Muy Lenta", "Media"),
  Precision = c("Baja", "Media", "Media-Alta", "Media", "Alta", "Alta"),
  Interpretabilidad = c("Alta", "Alta", "Media", "Alta", "Media", "Alta"),
  Uso_Principal = c("Ranking variables", "Relaciones marginales", 
                    "Heterogeneidad", "Explicación individual",
                    "Contribuciones justas", "Waterfall explicativo")
)

print(comparacion_xai)
                   Tecnica         Tipo  Velocidad  Precision Interpretabilidad
1       Feature Importance       Global Muy Rápida       Baja              Alta
2 Partial Dependence (PDP)       Global      Media      Media              Alta
3                ICE Plots Global/Local      Lenta Media-Alta             Media
4                     LIME        Local      Media      Media              Alta
5                  SHAPLEY        Local  Muy Lenta       Alta             Media
6         DALEX Break Down        Local      Media       Alta              Alta
           Uso_Principal
1      Ranking variables
2  Relaciones marginales
3         Heterogeneidad
4 Explicación individual
5  Contribuciones justas
6  Waterfall explicativo
# Visualización
ggplot(comparacion_xai, aes(x = Tipo, fill = Tipo)) +
  geom_bar() +
  labs(title = "Distribución de Técnicas por Tipo",
       x = "Tipo de Explicabilidad", y = "Número de Técnicas") +
  theme_minimal()

8.2 Recomendaciones de Uso

cat("=== CUÁNDO USAR CADA TÉCNICA ===\n\n")
=== CUÁNDO USAR CADA TÉCNICA ===
cat("1. FEATURE IMPORTANCE\n")
1. FEATURE IMPORTANCE
cat("   Usa cuando: Quieres un ranking rápido de variables importantes\n")
   Usa cuando: Quieres un ranking rápido de variables importantes
cat("   Cuidado: Puede ser engañosa con variables correlacionadas\n\n")
   Cuidado: Puede ser engañosa con variables correlacionadas
cat("2. PARTIAL DEPENDENCE PLOTS (PDP)\n")
2. PARTIAL DEPENDENCE PLOTS (PDP)
cat("   Usa cuando: Quieres entender relaciones marginales\n")
   Usa cuando: Quieres entender relaciones marginales
cat("   Cuidado: Asume independencia entre variables\n\n")
   Cuidado: Asume independencia entre variables
cat("3. ICE PLOTS\n")
3. ICE PLOTS
cat("   Usa cuando: Sospechas de heterogeneidad o interacciones\n")
   Usa cuando: Sospechas de heterogeneidad o interacciones
cat("   Cuidado: Difícil de interpretar con muchas líneas\n\n")
   Cuidado: Difícil de interpretar con muchas líneas
cat("4. LIME\n")
4. LIME
cat("   Usa cuando: Necesitas explicar una predicción específica rápido\n")
   Usa cuando: Necesitas explicar una predicción específica rápido
cat("   Cuidado: Puede ser inestable (diferentes ejecuciones, diferentes resultados)\n\n")
   Cuidado: Puede ser inestable (diferentes ejecuciones, diferentes resultados)
cat("5. SHAPLEY\n")
5. SHAPLEY
cat("   Usa cuando: Necesitas explicaciones locales robustas y justas\n")
   Usa cuando: Necesitas explicaciones locales robustas y justas
cat("   Cuidado: Computacionalmente costoso\n\n")
   Cuidado: Computacionalmente costoso
cat("6. DALEX\n")
6. DALEX
cat("   Usa cuando: Quieres un análisis completo y consistente\n")
   Usa cuando: Quieres un análisis completo y consistente
cat("   Cuidado: Requiere familiaridad con el framework\n\n")
   Cuidado: Requiere familiaridad con el framework

8.2.1 Ejercicio 8.1: Selección de técnicas

Pregunta 19: Si tuvieras que presentar resultados a un CEO no técnico, ¿qué 2-3 técnicas usarías?

Pregunta 20: Si un cliente reclama una decisión del modelo, ¿qué técnica usarías para explicarle?


9 CONCLUSIONES Y MEJORES PRÁCTICAS

9.1 Lecciones Clave

cat("=== CONCLUSIONES SOBRE EXPLICABILIDAD ===\n\n")
=== CONCLUSIONES SOBRE EXPLICABILIDAD ===
cat("1. NO HAY UNA TÉCNICA PERFECTA\n")
1. NO HAY UNA TÉCNICA PERFECTA
cat("   • Cada técnica tiene fortalezas y limitaciones\n")
   • Cada técnica tiene fortalezas y limitaciones
cat("   • Usa MÚLTIPLES técnicas para triangular resultados\n")
   • Usa MÚLTIPLES técnicas para triangular resultados
cat("   • Sé escéptico si diferentes técnicas dan resultados muy diferentes\n\n")
   • Sé escéptico si diferentes técnicas dan resultados muy diferentes
cat("2. CONTEXTO ES CLAVE\n")
2. CONTEXTO ES CLAVE
cat("   • Explicabilidad para expertos vs stakeholders vs reguladores\n")
   • Explicabilidad para expertos vs stakeholders vs reguladores
cat("   • Nivel de detalle depende de la audiencia\n")
   • Nivel de detalle depende de la audiencia
cat("   • Balance entre precisión y simplicidad\n\n")
   • Balance entre precisión y simplicidad
cat("3. CUIDADO CON INTERPRETACIONES ERRÓNEAS\n")
3. CUIDADO CON INTERPRETACIONES ERRÓNEAS
cat("   • Correlación ≠ Causalidad\n")
   • Correlación ≠ Causalidad
cat("   • Importancia ≠ Efecto directo\n")
   • Importancia ≠ Efecto directo
cat("   • Explicaciones locales ≠ Comportamiento global\n\n")
   • Explicaciones locales ≠ Comportamiento global
cat("4. DOCUMENTACIÓN\n")
4. DOCUMENTACIÓN
cat("   • Documenta qué técnicas usaste y por qué\n")
   • Documenta qué técnicas usaste y por qué
cat("   • Guarda las explicaciones junto con las predicciones\n")
   • Guarda las explicaciones junto con las predicciones
cat("   • Versiona modelos Y explicaciones\n\n")
   • Versiona modelos Y explicaciones
cat("5. ÉTICA Y REGULACIÓN\n")
5. ÉTICA Y REGULACIÓN
cat("   • GDPR requiere 'derecho a la explicación'\n")
   • GDPR requiere 'derecho a la explicación'
cat("   • Detecta y mitiga sesgos algorítmicos\n")
   • Detecta y mitiga sesgos algorítmicos
cat("   • La explicabilidad NO justifica decisiones injustas\n\n")
   • La explicabilidad NO justifica decisiones injustas

9.2 Workflow Recomendado

cat("=== WORKFLOW COMPLETO DE EXPLICABILIDAD ===\n\n")
=== WORKFLOW COMPLETO DE EXPLICABILIDAD ===
cat("PASO 1: ENTRENAMIENTO\n")
PASO 1: ENTRENAMIENTO
cat("  ✓ Entrena modelo con buen rendimiento\n")
  ✓ Entrena modelo con buen rendimiento
cat("  ✓ Evalúa en conjunto de test/validación\n\n")
  ✓ Evalúa en conjunto de test/validación
cat("PASO 2: EXPLICABILIDAD GLOBAL\n")
PASO 2: EXPLICABILIDAD GLOBAL
cat("  ✓ Feature Importance: ¿Qué variables importan?\n")
  ✓ Feature Importance: ¿Qué variables importan?
cat("  ✓ PDPs: ¿Cómo se relacionan con la predicción?\n")
  ✓ PDPs: ¿Cómo se relacionan con la predicción?
cat("  ✓ Interacciones: ¿Hay efectos combinados?\n\n")
  ✓ Interacciones: ¿Hay efectos combinados?
cat("PASO 3: VALIDACIÓN DE EXPLICACIONES\n")
PASO 3: VALIDACIÓN DE EXPLICACIONES
cat("  ✓ ¿Tienen sentido en el contexto del dominio?\n")
  ✓ ¿Tienen sentido en el contexto del dominio?
cat("  ✓ ¿Múltiples técnicas convergen?\n")
  ✓ ¿Múltiples técnicas convergen?
cat("  ✓ ¿Hay variables inesperadas?\n\n")
  ✓ ¿Hay variables inesperadas?
cat("PASO 4: EXPLICABILIDAD LOCAL\n")
PASO 4: EXPLICABILIDAD LOCAL
cat("  ✓ Selecciona observaciones clave (correctas, errores, edge cases)\n")
  ✓ Selecciona observaciones clave (correctas, errores, edge cases)
cat("  ✓ SHAPLEY o LIME para explicaciones individuales\n")
  ✓ SHAPLEY o LIME para explicaciones individuales
cat("  ✓ Compara explicaciones entre observaciones similares\n\n")
  ✓ Compara explicaciones entre observaciones similares
cat("PASO 5: COMUNICACIÓN\n")
PASO 5: COMUNICACIÓN
cat("  ✓ Adapta visualizaciones a la audiencia\n")
  ✓ Adapta visualizaciones a la audiencia
cat("  ✓ Reporta incertidumbre en las explicaciones\n")
  ✓ Reporta incertidumbre en las explicaciones
cat("  ✓ Proporciona ejemplos concretos\n\n")
  ✓ Proporciona ejemplos concretos
cat("PASO 6: MONITOREO\n")
PASO 6: MONITOREO
cat("  ✓ En producción, monitorea si las explicaciones cambian\n")
  ✓ En producción, monitorea si las explicaciones cambian
cat("  ✓ Detecta concept drift\n")
  ✓ Detecta concept drift
cat("  ✓ Re-explica periódicamente\n\n")
  ✓ Re-explica periódicamente

9.3 Ejercicio Final: Proyecto Completo

Tarea Final: Elige otro dataset (boston housing, titanic, diabetes, etc.) y:

  1. Entrena un modelo de caja negra (Random Forest, XGBoost, etc.)
  2. Aplica al menos 4 técnicas de explicabilidad diferentes
  3. Crea un reporte ejecutivo con:
    • Top 5 variables más importantes
    • 2-3 PDPs clave
    • Explicación de 1 predicción correcta y 1 error
    • Recomendaciones accionables
  4. Compara explicaciones entre técnicas

Pregunta 21: ¿Qué aprendiste sobre tu modelo que NO sabías solo mirando métricas?

Pregunta 22: ¿Las explicaciones te ayudaron a detectar problemas o sesgos?

Pregunta 23: ¿Qué técnica fue más útil para comunicar resultados a no expertos?


10 RECURSOS ADICIONALES

10.1 Librerías en R

  • iml: Interpretable Machine Learning (Molnar)
  • DALEX: Descriptive mAchine Learning EXplanations
  • pdp: Partial Dependence Plots
  • lime: Local Interpretable Model-agnostic Explanations
  • shapviz: Visualización de SHAP values
  • vip: Variable Importance Plots

10.2 Libros Recomendados

  1. Christoph Molnar - “Interpretable Machine Learning” (2022)
    • Online gratis: https://christophm.github.io/interpretable-ml-book/
  2. Przemyslaw Biecek & Tomasz Burzykowski - “Explanatory Model Analysis” (2021)
    • Enfocado en DALEX
  3. Patrick Hall & Navdeep Gill - “An Introduction to Machine Learning Interpretability” (2019)

10.3 Papers Clave

  • Ribeiro et al. (2016): “Why Should I Trust You?” - LIME
  • Lundberg & Lee (2017): “A Unified Approach to Interpreting Model Predictions” - SHAP
  • Friedman (2001): “Greedy Function Approximation: A Gradient Boosting Machine” - PDPs
  • Goldstein et al. (2015): “Peeking Inside the Black Box” - ICE Plots

Fin del Laboratorio 7: Explicabilidad e Interpretabilidad


10.4 Resumen del Laboratorio

En este laboratorio hemos aprendido:

Qué es XAI y por qué es crucial en ML moderno
Explicabilidad Global: Feature Importance, PDPs, ICE plots
Explicabilidad Local: LIME, SHAPLEY, DALEX Break Down
Frameworks completos: DALEX e iml
Casos prácticos: Explicar predicciones, errores, y dar recomendaciones
Comparación de técnicas y cuándo usar cada una
Mejores prácticas y workflow completo

Mensaje final: La explicabilidad NO es opcional - es fundamental para ML responsable, ético y confiable. ¡Nunca despliegues un modelo que no puedas explicar!